-- card: 5128 from stack: in.3 -- bmap block id: 0 -- flags: 4000 -- background id: 3241 -- name: WriteToFile ----- HyperTalk script ----- on Install get ChooseTargetStack() InstallResource XCMD,WriteToFile,it end Install -- part 1 (button) -- low flags: 00 -- high flags: A003 -- rect: left=79 top=300 right=322 bottom=179 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: WriteToFile ----- HyperTalk script ----- on mouseUp WriteToFile field 1,FALSE,"WriteToFile Docs",FALSE,"MSWD" put the result end mouseUp -- part 7 (field) -- low flags: 81 -- high flags: 2007 -- rect: left=12 top=26 right=298 bottom=491 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 0 -- font id: 22 -- text size: 10 -- style flags: 0 -- line height: 13 -- part name: Source -- part 8 (button) -- low flags: 00 -- high flags: A003 -- rect: left=299 top=300 right=322 bottom=438 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 0 -- line height: 16 -- part name: Show Pascal Source ----- HyperTalk script ----- on mouseUp set the visible of card field 1 to not the visible of card field 1 if the visible of card field 1 is true then set the name of me to "Hide Pascal Source" else set the name of me to "Show Pascal Source" end mouseUp -- part contents for background part 16 ----- text ----- WRITETOFILE XCMD version 1.0 Kevin Calhoun The WriteToFile XCMD writes the contents of a HyperCard container to a text file. The file may be designated by its full pathname, or it may be given by the user in a standard file dialog. WriteToFile can append to an existing file, replace an existing file, or create a new file. Use some caution when using WriteToFile. It will overwrite or append to a file you designate by full pathname even if that file is better off left alone. It does not check whether an existing file is a TEXT file. If an error occurs, WriteToFile returns an error message as the Result. Word 1 of this message will be "Error." If the file was written successfully, WriteToFile returns the full pathname of the file as the Result. INVOKING WRITETOFILE WriteToFile container,,<"name">,, The first parameter, container, is the name of a HyperTalk container. This can be a field, a variable, a function, or, in sum, anything you can "get". For example, WriteToFile card field 1 will write the contents of card field 1 to a file, while WriteToFile containerName will write the contents of the HyperTalk variable called "containerName" to a file. The second parameter, usePathname, tells WriteToFile how to interpret the third parameter. If usePathname is TRUE, WriteToFile attempts to write to the file whose full pathname is given in parameter 3. If usePathname is false, WriteToFile invokes standard file with the contents of parameter 3 given as the default name for the file. If standard file is invoked and the user pushes the cancel button in the dialog box, FileToField returns "Cancel" as the Result. If the fourth parameter, append, is TRUE, WriteToFile appends to the file rather than replacing its contents. Note that this parameter has no significance unless the WriteToFile is writing to an existing file designated by full pathname. If you want to be able to open your favorite word processor by double-clicking in the Finder on the text file that WriteToFile creates, you must supply the creator parameter. For MacWrite, the creator is "MACA." For Microsoft Word, the creator is "MSWD." If you don't specify a creator, WriteToFile will default to MACA. Note that this parameter is not significant unless WriteToFile is creating a new file. The creator of an existing file will not be changed. EXAMPLES WriteToFile bkgnd field id 3 -- standard file will be invoked WriteToFile card field 5,TRUE,"TheFattaTheLand:Of Mice And Men:My Book Report" WriteToFile variableName,TRUE,"MyHD:MyFile",TRUE -- append to existing file REVISION HISTORY 30 April 1989 1.0 NOTE TO USERS OF FIELDTOFILE: WriteToFile does everything that FieldToFile could do, except that it can't write to an AppleShare drop folder. The parameter list is quite different; the most important difference is that, when using WriteToFile, you must not put a field designation in quotation marks. -- part contents for card part 7 ----- text ----- UNIT DisksEngravedWhileUWait; { WriteToFile XCMD © 1988-1989 by the Trustees of Dartmouth College } { Written by Kevin Calhoun } { This source compatible with MPW Pascal 3.0 } (* Pascal WriteToFile.p Link -m ENTRYPOINT ∂ -o "YourFile" ∂ -rt XCMD=2240 ∂ -sn Main=WriteToFile ∂ WriteToFile.p.o ∂ "{Libraries}"interface.o ∂ "{PLibraries}"Paslib.o ∂ "{Libraries}"HyperXLib.o *) {$R-} INTERFACE USES Types, Memory, Files, Resources, Errors, Packages, HyperXCmd; PROCEDURE EntryPoint (paramPtr : XCMDPtr); IMPLEMENTATION PROCEDURE ContainerToFile (paramPtr: XCMDPtr); FORWARD; PROCEDURE EntryPoint (paramPtr : XCMDPtr); BEGIN ContainerToFile(paramPtr); END; FUNCTION GetScreenBitsBounds: Rect; { get screenbits.bounds from the QuickDraw globals } TYPE LongwordPtr = ^LONGINT; BitMapPtr = ^BitMap; CONST screenBitsOffset = -122; CurrentA5 = $904; VAR screenBitsPtr : BitMapPtr; myLongwordPtr : LongwordPtr; BEGIN myLongwordPtr := LongwordPtr(CurrentA5); { myLongwordPtr now points to the pointer to the first QD global } myLongwordPtr := LongwordPtr(myLongwordPtr^); { myLongwordPtr now points to the first QD global } screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset); { screenBitsPtr now points to the screenBits BitMap } GetScreenBitsBounds := screenBitsPtr^.bounds; END; FUNCTION BuildThePathname (fName : Str255; vRefNum : INTEGER) : Str255; { Given the "short name" and vRefNum of a file, returns the full pathname. } { This function is adapted from Steve Maller's FileName XFCN published in } { HyperTalk Programming by Dan Shafer, Howard W. Sams & Company, 1988, } { pp. 399-403. } VAR name, fullPathName : Str255; err : INTEGER; myWDPB : WDPBPtr; myCPB : CInfoPBPtr; myPB : HParmBlkPtr; BEGIN fullPathName := ''; { start with an empty pathname } { Allocate some memory in the heap for the parameter block. } myCPB := CInfoPBPtr(NewPtr(SizeOf(HParamBlockRec))); IF ord4(myCPB) > 0 THEN { continue if mem allocation was OK } BEGIN myWDPB := WDPBPtr(myCPB); myPB := HParmBlkPtr(myCPB); { same pointer, different variations of the record -- see IM IV, p. 117 } name := ''; { start with an empty name for the volume } WITH myPB^ DO BEGIN ioNamePtr := @name; { we want the volume name } ioCompletion := pointer(0); ioVRefNum := vRefNum; { returned by SFGetFile } ioVolIndex := 0; { use the vRefNum and name only to designate volume } END; err := PBHGetVInfo(myPB, FALSE); { fill in the volume info } IF err = noErr THEN BEGIN { Now we need the Working Directory (WD) information because we're } { going to step backwards from the file through all of the folders until } { we reach the root directory. } WITH myWDPB^ DO BEGIN ioVRefNum := vRefNum; { this got set to 0 above } ioWDProcID := 0; { use the vRefNum } ioWDIndex := 0; { we want all directories } END; err := PBGetWDInfo(myWDPB, FALSE); IF err = noErr THEN BEGIN WITH myCPB^ DO BEGIN ioFDirIndex := -1; { use the ioDirID field only } ioDrDirID := myWDPB^.ioWDDirID; { info returned above } END; err := PBGetCatInfo(myCPB, FALSE); IF err = noErr THEN BEGIN { Here starts the real work -- start to climb the tree by continually } { looking in the ioDrParID field for the next directory above until we fail... } myCPB^.ioDrDirID := myCPB^.ioDrParID; { the first folder } fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fName); REPEAT myCPB^.ioDrDirID := myCPB^.ioDrParId; err := PBGetCatInfo(myCPB, FALSE); { the next level } { Be careful of an error returned here -- it means the user chose a file on the } { desktop level of this volume. If this is the case, just stop here and return } { "VolumeName:FileName"; otherwise loop until failure. } IF err = noErr THEN fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fullPathName); UNTIL err <> noErr; END; { if PBGetCatInfo worked OK } END; { if PBGetWDInfo worked OK } END; { if PBHGetVInfo worked OK } DisposPtr(pointer(myCPB)); END; { if we had enough room for a new pointer } BuildThePathname := fullPathName; END; PROCEDURE GetFileName(paramPtr:XCMDPtr; var str:Str255); BEGIN IF paramPtr^.paramCount > 2 THEN ZeroToPas(paramPtr, paramPtr^.params[3]^, str) ELSE str := ''; END; PROCEDURE GetCreator(paramPtr: XCMDPtr; VAR creator: OSType); VAR str: Str255; BEGIN IF paramPtr^.paramCount > 4 THEN BEGIN str := ' '; ZeroToPas(paramPtr, paramPtr^.params[5]^, str); BlockMove(Ptr(ORD4(@str)+1),@creator,4); END ELSE creator := 'MACA'; END; FUNCTION GotFileFromSFPut(var volume: INTEGER; var fileName: Str255): BOOLEAN; VAR where : Point; reply : SFReply; dlgt: DialogTHndl; r: rect; screen: rect; h, v: INTEGER; BEGIN dlgt := DialogTHndl(GetResource('DLOG',putDlgID)); if dlgt <> nil then begin r := dlgt^^.boundsRect; screen := GetScreenBitsBounds; h := ((screen.right - screen.left) - (r.right - r.left)) div 2; v := ((screen.bottom - screen.top) - (r.bottom - r.top)) div 2; SetPt(where, h, v); end else SetPt(where, 82, 75); SFPutFile(where, '', fileName, NIL, reply); WITH reply DO BEGIN IF good THEN BEGIN fileName := fName; volume := vRefNum; END; GotFileFromSFPut := good; END; END; FUNCTION FlushVolOfFile(fRefNum: INTEGER): OSErr; LABEL 99; VAR err: OSErr; myFCBPBHndl: Handle; myFCBPBPtr: FCBPBPtr; BEGIN err := noErr; myFCBPBHndl := NewHandleClear(SIZEOF(FCBPBRec)); err := MemError; IF err <> noErr THEN GOTO 99; MoveHHi(myFCBPBHndl); HLock(myFCBPBHndl); myFCBPBPtr := FCBPBPtr(myFCBPBHndl^); myFCBPBPtr^.ioRefNum := fRefNum; err := PBGetFCBInfo(myFCBPBPtr, FALSE); IF err=noErr THEN err := FlushVol(NIL,myFCBPBPtr^.ioVRefNum); DisposHandle(myFCBPBHndl); 99: FlushVolOfFile := err; END; FUNCTION WriteToFile(vRefNum: INTEGER; fileName: Str255; textPtr: Ptr; VAR count: LONGINT; creator: OSType; append: BOOLEAN): OSErr; LABEL 98,99; VAR err: OSErr; fRefNum: INTEGER; fileLength: LONGINT; BEGIN err := Create(fileName,vRefNum,creator,'TEXT'); IF (err <> noErr)&(err<>dupFNErr) THEN GOTO 99; err := FSOpen(fileName,vRefNum,fRefNum); IF err <> noErr THEN GOTO 99; IF append THEN BEGIN err := GetEOF(fRefNum,fileLength); IF err <> noErr THEN GOTO 98; END ELSE fileLength := 0; err := SetFPos(fRefNum,fsFromStart,fileLength); IF err <> noErr THEN GOTO 98; err := FSWrite(fRefNum, count, textPtr); IF err<>noErr THEN GOTO 98; err := SetEOF(fRefNum, fileLength+count); err := FlushVolOFFile(fRefNum); 98: err := FSClose(fRefNum); 99: WriteToFile := err; END; PROCEDURE ContainerToFile (paramPtr : XCMDPtr); LABEL 100; VAR theText: Handle; str: Str255; vRefNum: INTEGER; usePathName: BOOLEAN; creator: OSType; append: BOOLEAN; hs: SignedByte; theLength: LONGINT; err : OSErr; PROCEDURE PassReturnValue (theMsg : Str255); { set theResult and quit } BEGIN paramPtr^.returnValue := PasToZero(paramPtr, theMsg); END; BEGIN err := noErr; IF paramPtr^.paramCount < 1 THEN BEGIN PassReturnValue('WriteToFile XCMD 1.0, 30 April 1989, ©1988-1989 Dartmouth College'); GOTO 100; END; theText := paramPtr^.params[1]; usePathName := FALSE; IF paramPtr^.paramCount > 1 THEN BEGIN ZeroToPas(paramPtr,paramPtr^.params[2]^,str); usePathName := StrToBool(paramPtr,str); END; append := FALSE; IF paramPtr^.paramCount > 3 THEN BEGIN ZeroToPas(paramPtr,paramPtr^.params[4]^,str); append := StrToBool(paramPtr,str); END; GetFileName(paramPtr,str); IF usePathName THEN BEGIN vRefNum := 0; IF LENGTH(str) = 0 THEN BEGIN err := bdNamErr; GOTO 100; END; END ELSE IF NOT GotFileFromSFPut(vRefNum,str) THEN BEGIN PassReturnValue('Cancel'); GOTO 100; END; GetCreator(paramPtr,creator); hs := HGetState(theText); HLock(theText); theLength := StringLength(paramPtr, theText^); err := WriteToFile(vRefNum,str,theText^,theLength,creator,append); HSetState(theText,hs); IF NOT usePathName THEN str := BuildThePathName(str,vRefNum); PassReturnValue(str); 100: IF err <> noErr THEN BEGIN NumToStr(paramPtr,err,str); PassReturnValue(CONCAT('Error ',str)); END; END; END.